;;;Place soldier course on 'right' side of polyline or spline beginning at nearest end.
;;;Requires blocks named "CRSE<width>x<length>A" and "CRSE<width>x<length>B"
;;;where <width> and <length> are integers with their value = the dimensions x 8
;;;(i.e., = the whole number of eigths contained in each dimension)
;;;	Author:
;;;		Henry C. Francis
;;;		425 N. Ashe Street
;;;		Southern Pines, NC 28387
;;;
;;;	http://paracadd.com
;;;	All rights reserved.
;;;
(defun c:soldier ()
  (setq b_width (ureal 1 "" "Brick width" b_width))
  (setq b_length (ureal 1 "" "Brick length" b_length))
  (setq	bname_a	(strcat	"CRSE"
			(rtos (/ b_width 0.125) 2 0)
			"X"
			(rtos (/ b_length 0.125) 2 0)
			"A"
		) ;_ end of strcat
  ) ;_ end of setq
  (setq	bname_b	(strcat	"CRSE"
			(rtos (/ b_width 0.125) 2 0)
			"X"
			(rtos (/ b_length 0.125) 2 0)
			"B"
		) ;_ end of strcat
  ) ;_ end of setq
  (if (tblsearch "block" bname_a) ;_ end of tblsearch
    nil
    (progn
      (entmake
	(list (cons 0 "BLOCK")
	      (cons 2 bname_a)
	      (cons 70 64)
	      (cons 10 (list 0.0 0.0 0.0))
	) ;_ end of list
      ) ;_ end of entmake
      (entmake (list (cons 0 "LINE")
		     (cons 67 0)
		     (cons 8 "0")
		     (cons 10 (list 0.0 0.0 0.0))
		     (cons 11 (list 0.0 b_length 0.0))
		     (cons 210 (list 0.0 0.0 1.0))
	       ) ;_ end of list
      ) ;_ end of entmake
      (entmake '((0 . "ENDBLK")))
    ) ;_ end of progn
  ) ;_ end of if
  (if (tblsearch "block" bname_b) ;_ end of tblsearch
    nil
    (progn
      (entmake
	(list (cons 0 "BLOCK")
	      (cons 2 bname_b)
	      (cons 70 64)
	      (cons 10 (list 0.0 0.0 0.0))
	) ;_ end of list
      ) ;_ end of entmake
      (entmake (list (cons 0 "LINE")
		     (cons 67 0)
		     (cons 8 "0")
		     (cons 10 (list 0.0 0.0 0.0))
		     (cons 11 (list 0.0 (- 0 b_length) 0.0))
		     (cons 210 (list 0.0 0.0 1.0))
	       ) ;_ end of list
      ) ;_ end of entmake
      (entmake '((0 . "ENDBLK")))
    ) ;_ end of progn
  ) ;_ end of if
  (command ".undo" "m")
  (setq ment (entsel "\nSelect object for soldier course: "))
  (cond
    ((eq (cdr (assoc 0 (entget (car ment)))) "LINE")
     (if (> (distance (cadr ment) (cdr (assoc 10 (entget (car ment)))))
	    (distance (cadr ment) (cdr (assoc 11 (entget (car ment)))))
	 ) ;_ end of >
       (setq meablk bname_a)
       (setq meablk bname_b)
     ) ;_ end of if
    )
    ((eq (cdr (assoc 0 (entget (car ment)))) "ARC")
     (setq meablk bname_a)
    )
    ((eq (cdr (assoc 0 (entget (car ment)))) "POLYLINE")
     (setq enext (entnext (car ment)))
     (while (not (eq (cdr (assoc 0 (entget enext))) "SEQEND"))
       (setq lastent enext
	     enext   (entnext enext)
       ) ;_ end of setq
     ) ;_ end of while
     (if
       (> (distance
	    (cadr ment)
	    (cdr
	      (assoc 10
		     (entget (entnext (cdr (assoc -2 (entget enext)))))
	      ) ;_ end of assoc
	    ) ;_ end of cdr
	  ) ;_ end of distance
	  (distance (cadr ment) (cdr (assoc 10 (entget lastent))))
       ) ;_ end of >
	(setq meablk bname_a)
	(setq meablk bname_b)
     ) ;_ end of if
    )
    ((eq (cdr (assoc 0 (entget (car ment)))) "SPLINE")
     (setq pt_ndx (cdr (assoc 73 (entget (car ment)))))
     (if
       (> (distance (cadr ment)
		    (cdr (nth 0 (reverse (entget (car ment)))))
	  ) ;_ end of distance
	  (distance (cadr ment)
		    (cdr (nth (1- pt_ndx) (reverse (entget (car ment)))))
	  ) ;_ end of distance
       ) ;_ end of >
	(setq meablk bname_a)
	(setq meablk bname_b)
     ) ;_ end of if
    )
    ((and
       (not (eq (cdr (assoc 0 (entget (car ment)))) "POLYLINE"))
       (not (eq (cdr (assoc 0 (entget (car ment)))) "LINE"))
       (not (eq (cdr (assoc 0 (entget (car ment)))) "SPLINE"))
       (not (eq (cdr (assoc 0 (entget (car ment)))) "ARC"))
     ) ;_ end of and
     (princ "\nSelect POLYLINE, LINE, SPLINE or ARC ")
    )
  ) ;_ end of cond
  (if (or
	(eq (cdr (assoc 0 (entget (car ment)))) "POLYLINE")
	(eq (cdr (assoc 0 (entget (car ment)))) "LINE")
	(eq (cdr (assoc 0 (entget (car ment)))) "SPLINE")
	(eq (cdr (assoc 0 (entget (car ment)))) "ARC")
      ) ;_ end of or
    (command ".measure" (cadr ment) "b" meablk "y" b_width)
  ) ;_ end of if
  (princ)
) ;_ end of defun

;|+Visual LISP) Format Options; (72 2 40 2 T "end of " 60 9 0 0 0 T T nil T)
 ***Don't add text below the comment!***|;
